home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1995 March / PC Plus Super CD (Issue 101) (March 1995).iso / sharewar / vbaddon / vbfiles / sam4.bas < prev    next >
Encoding:
BASIC Source File  |  1994-06-24  |  8.3 KB  |  221 lines
  1. Option Explicit
  2.  
  3. 'Global constant codes for TellUser routine:
  4. Global Const CLOSE_ERROR = 1
  5. Global Const OPEN_ERROR = 2
  6. Global Const INFO_ERROR = 3
  7. Global Const CANT_ACCESS_SCHEMA_FILE = 4
  8. Global Const ACCESS_DENIED = 5
  9. Global Const DEFAULT_SCHEMA = 6
  10. Global Const INDEX_IS_EMPTY = 7
  11. Global Const BOFERROR = 8
  12. Global Const EOFERROR = 9
  13. Global Const GETERROR = 10
  14. Global Const NULL_PRIMARY_KEY = 11
  15. Global Const CANNOT_READD_SAME_RECORD = 12
  16. Global Const RECORD_ALREADY_EXISTS = 13
  17. Global Const PUTERROR = 14
  18. Global Const SHOULD_ADD_NOT_UPDATE = 15
  19. Global Const MUST_RESTORE_PRIMARY_KEY = 16
  20. Global Const DELETEERROR = 17
  21. Global Const NOTHING_TO_UPDATE = 18
  22. Global Const NOT_A_CSV_FILE = 19
  23. Global Const TOO_MANY_FIELDS = 20
  24. Global Const TYPE_TOO_LARGE = 21
  25. Global Const FIELDPACKERROR = 22
  26. Global Const EXPORT_ABORTED = 23
  27. Global Const NO_SEARCH_TEXT = 24
  28.  
  29.  
  30. Global rc As Integer    'Return Code (for function calls)
  31. Global CRLFDelim As String
  32. Global BarDelim As String
  33. Global DatasetRefNum As Integer  'DatasetNumber returned by successful VmxOpen call
  34. Global DatasetAccessMode As Integer
  35. Global Const READ_ONLY = 0
  36. Global Const READ_WRITE = 1
  37. Global SchemaFileName As String
  38. Global SchemaFileNum As Integer
  39. Global SchemaFileAccessibleFlag As Integer
  40. Global SchemaFileContents As String
  41. Global SchemaCommentHeader As String
  42. Global Schema As String
  43. Global SchemaLine As String
  44. Global ThisType As String
  45.  
  46. Global ExportFileName As String
  47. Global ExportFileNum As Integer
  48.  
  49. Global SchemaDirtyFlag As Integer
  50. Global SuppressChangeEventFlag As Integer
  51. Global ChangeAlertFlag As Integer
  52. Global ClearOrRestoreToggle As Integer  '0-->clear; 1-->restore
  53.  
  54. Global DatasetInfo As VBISAMInfo    'See VBIS23MX.BAS
  55. Global NumberOfFields As Integer
  56. Global NumberOfDisplayedFields As Integer
  57. Global FieldType(0 To 10) As String
  58. Global FieldNum As Integer
  59. Global CurrentIndex As Integer
  60. Global LastIndexListIndex As Integer
  61.  
  62. Global PrimaryKey As String     'VBPROD primary key is product name
  63. Global DisplayedPrimaryKey As String
  64. Global SavedPrimaryKey As String
  65. Global Throwaway As String
  66.  
  67. Type RecordBufferType   'hard-wired for C:\VBPROD dataset
  68.     Description As String
  69.     ProductCategory As String
  70.     FileType As String * 3
  71.     BasePrice As Currency
  72.     PricingNotes As String
  73.     CatalogPage As String * 3
  74.     CompanyName As String
  75.     Phone As String
  76.     Fax As String
  77.     Comments As String
  78. End Type
  79. Global RecordBuffer As RecordBufferType
  80. Global ExportRecBuffer As RecordBufferType
  81.  
  82. Global Const GREEN = &H8000&
  83. Global Const LIGHT_GREY = &HC0C0C0
  84. Global Const WHITE = &H80000005
  85. Global Const BLUE = &HFFFF00
  86.  
  87. Global MBType As Integer
  88. Global MBTitle As String
  89. Global Msg As String
  90.  
  91.  
  92. ' ---------------- From Microsoft VB "CONSTANT.TXT" file:
  93.  
  94. ' Form display
  95. Global Const MODAL = 1
  96.  
  97. ' MsgBox parameters
  98. Global Const MB_OK = 0                 ' OK button only
  99. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  100. Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
  101. Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
  102. Global Const MB_YESNO = 4              ' Yes and No buttons
  103. Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
  104.  
  105. Global Const MB_ICONSTOP = 16          ' Critical message
  106. Global Const MB_ICONQUESTION = 32      ' Warning query
  107. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  108. Global Const MB_ICONINFORMATION = 64   ' Information message
  109.  
  110. Global Const MB_APPLMODAL = 0          ' Application Modal Message Box
  111. Global Const MB_DEFBUTTON1 = 0         ' First button is default
  112. Global Const MB_DEFBUTTON2 = 256       ' Second button is default
  113. Global Const MB_DEFBUTTON3 = 512       ' Third button is default
  114. Global Const MB_SYSTEMMODAL = 4096      'System Modal
  115.  
  116. ' MsgBox return values
  117. Global Const IDOK = 1                  ' OK button pressed
  118. Global Const IDCANCEL = 2              ' Cancel button pressed
  119. Global Const IDABORT = 3               ' Abort button pressed
  120. Global Const IDRETRY = 4               ' Retry button pressed
  121. Global Const IDIGNORE = 5              ' Ignore button pressed
  122. Global Const IDYES = 6                 ' Yes button pressed
  123. Global Const IDNO = 7                  ' No button pressed
  124.  
  125. ' Common Dialog
  126. Global Const DLG_FILE_OPEN = 1
  127. Global Const DLG_FILE_SAVE = 2
  128. Global Const OFN_READONLY = &H1&
  129. Global Const OFN_FILEMUSTEXIST = &H1000&
  130.  
  131. Sub ExitProgram ()
  132.  
  133.     If DatasetRefNum <> 0 Then rc = VmxClose(DatasetRefNum)
  134.     
  135.     End
  136.  
  137. End Sub
  138.  
  139. Sub TellUser (MessageID As Integer)
  140.  
  141.     MBType = MB_ICONEXCLAMATION
  142.  
  143.     Select Case MessageID
  144.         Case CLOSE_ERROR
  145.             Msg = "Can't close file; must make emergency exit."
  146.         Case OPEN_ERROR
  147.             Msg = "Could not open dataset C:\VBPROD"
  148.         Case INFO_ERROR
  149.             Msg = "Error getting dataset information; must make emergency exit."
  150.         Case CANT_ACCESS_SCHEMA_FILE
  151.             Msg = "Unable to open schema file (xxxxx.ISS) for read-write."
  152.         Case ACCESS_DENIED
  153.             Msg = "This dataset is currently in use."
  154.         Case DEFAULT_SCHEMA
  155.             MBType = MB_ICONINFORMATION
  156.             Msg = "Initializing new schema file (xxxxx.ISS) to default values."
  157.         Case INDEX_IS_EMPTY
  158.             MBType = MB_ICONINFORMATION
  159.             If CurrentIndex = 0 Then
  160.                 Msg = "Dataset is empty (no records)."
  161.             Else
  162.                 Msg = "This index is empty."
  163.             End If
  164.         Case BOFERROR
  165.             Msg = "Error in VmxBOF usage."
  166.         Case EOFERROR
  167.             Msg = "Error in VmxEOF usage."
  168.         Case GETERROR
  169.             Msg = "Error in VmxGet usage."
  170.         Case NULL_PRIMARY_KEY
  171.             MBType = MB_ICONINFORMATION
  172.             Msg = "Must have a non-blank primary key to add a record."
  173.         Case CANNOT_READD_SAME_RECORD
  174.             MBType = MB_ICONINFORMATION
  175.             Msg = "Cannot re-add the same record.  Either:" & CRLFDelim & Chr$(10)
  176.             Msg = Msg & "...enter a new primary key to add a new record," & CRLFDelim & Chr$(10)
  177.             Msg = Msg & "or" & CRLFDelim & Chr$(10)
  178.             Msg = Msg & "...click 'Update Record' to change this record's data."
  179.         Case RECORD_ALREADY_EXISTS
  180.             MBType = MB_ICONINFORMATION
  181.             Msg = "This primary key already exists in the file; cannot add this record.  (Primary keys are unique record identifiers.)"
  182.         Case PUTERROR
  183.             Msg = "Error in VmxPut usage."
  184.         Case SHOULD_ADD_NOT_UPDATE
  185.             MBType = MB_ICONINFORMATION
  186.             Msg = "You've changed the primary key; primary keys uniquely identify records.  If you want"
  187.             Msg = Msg & " this NEW record to be ADDED to the file, click 'Add Record' rather than 'Update Record.'"
  188.         Case MUST_RESTORE_PRIMARY_KEY
  189.             MBType = MB_ICONINFORMATION
  190.             Msg = "You've changed the primary key; please restore it, or re-find the original record, before deleting."
  191.         Case DELETEERROR
  192.             Msg = "Error in VmxDelete usage."
  193.         Case NOTHING_TO_UPDATE
  194.             MBType = MB_ICONINFORMATION
  195.             Msg = "You haven't changed any data."
  196.         Case NOT_A_CSV_FILE
  197.             Msg = "File extension for export must be .CSV ('comma-separated values')."
  198.         Case TOO_MANY_FIELDS
  199.             Msg = "This program can manage a maximum of 99 fields; the records in this dataset have more than that.  (Sorry.)"
  200.         Case TYPE_TOO_LARGE
  201.             Msg = "This program cannot process this record format (more than 4096 bytes are required to store its Type structure); sorry."
  202.         Case FIELDPACKERROR
  203.             Msg = "Error in FieldPack function usage."
  204.         Case EXPORT_ABORTED
  205.             MBType = MB_ICONINFORMATION
  206.             Msg = "Export process stopped at your request; .CSV file has been deleted."
  207.         Case NO_SEARCH_TEXT
  208.             Msg = "Please enter your search-key in the text-box above this Seek button." & CRLFDelim & CRLFDelim
  209.             Msg = Msg & "(Will seek to >= your search-key in the current index; see Help.)"
  210.         Case Else
  211.             Msg = "Program error code #" & Str$(MessageID) & "." & Chr$(13) & Chr$(10) & Chr$(10) & "Call for support."
  212.             MBType = MB_ICONSTOP
  213.             MsgBox Msg, MBType, MBTitle
  214.             End '!!! PANIC BAIL-OUT !!!
  215.     End Select
  216.  
  217.     MsgBox Msg, MBType, MBTitle
  218.  
  219. End Sub
  220.  
  221.